-- Sort.hs
module MySort where

-- ================================= 插入
insert :: (Ord a) => a -> [a] -> [a]
insert x [] = [x] -- (0)
insert x xs@(y : ys)
  | x < y = x : xs -- (1)
  | otherwise = y : insert x ys -- (2)

-- +++++++++++++++++++++++++ 插入排序
_insertionSort :: (Ord a) => [a] -> [a] -> [a]
_insertionSort xs [] = xs
_insertionSort xs (y : ys) = _insertionSort (insert y xs) ys

insertionSort :: (Ord a) => [a] -> [a]
insertionSort = _insertionSort []

{-
insertionSort [7,5,12,10]
-}
-- ================================= 插入排序, 原地插入
insertionSort2 :: (Ord a) => [a] -> [a]
insertionSort2 [] = []
insertionSort2 (x : xs) = insert x (insertionSort2 xs)

{-
insertionSort2 [7,5,12,10]
-}

-- ================================= 冒泡排序
-- 交换函数, 将 泡元素 移动到列表末端
swaps :: (Ord a) => [a] -> [a]
swaps [] = []
swaps [x] = [x]
swaps (x1 : x2 : xs)
  | x1 > x2 = x2 : swaps (x1 : xs)
  | otherwise = x1 : swaps (x2 : xs)

-- 不动点函数
fix :: (Eq t) => (t -> t) -> t -> t
fix f x
  | x == x' = x
  | otherwise = fix f x'
  where
    x' = f x

bubbleSort :: (Ord a) => [a] -> [a]
bubbleSort xs = fix swaps xs

{-
bubbleSort [7,12,3,5,10]
-}

-- ++++++++++++++ 隐式 不动点函数
bubbleSort' :: (Ord a) => [a] -> [a]
bubbleSort' xs
  | xs' == xs = xs
  | otherwise = bubbleSort' xs'
  where
    xs' = swaps xs

{-
bubbleSort' [7,12,3,5,10]
-}

-- +++++++++++++++++++++++++ 效率优化版
bubbleSort'' :: (Ord a) => [a] -> [a]
bubbleSort'' [] = []
bubbleSort'' xs = bubbleSort'' initialElements ++ [lastElement]
  where
    swappedxs = swaps xs
    initialElements = init swappedxs
    lastElement = last swappedxs

{-
bubbleSort'' [7,12,3,5,10]
-}

-- ======================================= 比较效率

-- n 存储当前交换次数
swp2 n [] = (n, [])
swp2 n [x] = (n, [x])
swp2 n (x1 : x2 : xs)
  | x1 > x2 = (fst mA + n + 1, x2 : snd mA) --  比较+交换操作，耗费1
  | otherwise = (fst mB + n + 0.5, x1 : snd mB) -- 比较操作, 耗费 0.5
  where
    mA = swp2 0 (x1 : xs)
    mB = swp2 0 (x2 : xs)

-- n 存储当前 swap 总次数
bSort n xs
  | mxs' == xs = (n + mN, xs)
  | otherwise = bSort (n + mN) mxs'
  where
    mE = swp2 0 xs
    mN = fst mE
    mxs' = snd mE

-- n 存储当前 swap 总次数
bSort2 n [] = (n, [])
bSort2 n xs = (rA, rB ++ [lastElement])
  where
    mE = swp2 0 xs
    mN = fst mE
    swappedxs = snd mE
    initialElements = init swappedxs
    lastElement = last swappedxs
    ret = bSort2 (n + mN) initialElements
    rA = fst ret
    rB = snd ret

{-
bSort 0 [7,12,3,5,10,88,9,56,25,36,45,41,17,19,13,35,69,998,87,774,75,62,36,51,22,78]
247.0
bSort2 0 [7,12,3,5,10,88,9,56,25,36,45,41,17,19,13,35,69,998,87,774,75,62,36,51,22,78]
209.5
-}

-- ============================================== 选择排序
delete :: (Eq a) => a -> [a] -> [a]
delete _ [] = []
delete x (l : ls)
  | x == l = ls
  | otherwise = l : delete x ls

selectionSort [] = []
selectionSort xs = mini : selectionSort xs'
  where
    mini = minimum xs
    xs' = delete mini xs

{-
selectionSort [7,12,3,5,10]
-}

-- ============================================== 快速排序 quick sort
-- Sir Charles Antony Richard Hoare
quickSort :: (Ord a) => [a] -> [a]
quickSort [] = []
quickSort (x : xs) = quickSort mini ++ [x] ++ quickSort maxi
  where
    mini = filter (< x) xs
    maxi = filter (>= x) xs

{-
quickSort [7,12,3,13,5,10,1]
-}

-- ++++++++++++++++++++++++++++++++++++++++++++++ 效率优化
filterSplit :: (a -> Bool) -> [a] -> ([a], [a])
filterSplit _ [] = ([], [])
filterSplit f (x : xs)
  | f x = (x : l, r) -- True
  | otherwise = (l, x : r) -- False
  where
    (l, r) = filterSplit f xs

-- 优化版 quick sor
quickSort' :: (Ord a) => [a] -> [a]
quickSort' [] = []
quickSort' [x] = [x]
quickSort' (x : xs) = quickSort' l ++ [x] ++ quickSort' r
  where
    (l, r) = filterSplit (< x) xs

{-
quickSort' [7,12,3,13,5,10,1]
-}

-- ============================================== 归并排序 merge sort
-- 合并两个有序列表
merge :: (Ord a) => [a] -> [a] -> [a]
merge xs [] = xs
merge [] ys = ys
merge xs'@(x : xs) ys'@(y : ys)
  | x > y = y : merge xs' ys
  | otherwise = x : merge xs ys'

-- merge 排序
msort :: (Ord a) => [a] -> [a]
msort [] = []
msort [x] = [x]
msort xs = merge (msort x1) (msort x2)
  where
    (x1, x2) = halve xs
    halve xs = (take l xs, drop l xs)
    l = (length xs) `div` 2

{-
msort "Haskell is fun"
msort [6,4,7,9,1,4]
-}